Spatial Referencing

## Reads in AOI position text files from Toii
## Will return tibble of columns sec, x, y, with rows for each timestamp/AOI position

get_xy_timestamp <- function(z){

x <- read_lines(z) %>%
  as_tibble() %>%
  rowid_to_column("ID")

# pull out timestamp rows
timestamps <- x %>%
  filter(str_detect(value, "timestamp")) %>%
  separate(value, into = c("throw","timestamp"), sep = " = ") %>%
  separate(timestamp, into = c("one","two","sec"), sep = ":") %>%
  select(sec) %>%
  mutate(sec = as.numeric(sec))

# Find AOI coordinate rows
xys <- x %>%
  mutate(find = str_detect(value, "X\tY"))

# first vertex (2 rows after each "XY" line)
xys_row <- which(xys$find) + 2

xy1 <- x %>%
  filter(ID %in% xys_row) %>%
  separate(value, into = c("x1","y1"), sep = "\t") %>%
  select(-ID)

# opposite vertex (2 more rows down)
xys_row <- xys_row + 2

xy2 <- x %>%
  filter(ID %in% xys_row) %>%
  separate(value, into = c("x2","y2"), sep = "\t") %>%
  select(-ID)

# Now get average XY position per timestamp
xys <- cbind(timestamps, xy1, xy2) %>%
  mutate_all(as.numeric) %>%
  rowwise() %>%
  mutate(x = mean(x1,x2),
         y = mean(y1, y2)) %>%
  select(sec, x, y)
}

Let’s give this a shot!!

Three Bears Forward

First let’s see who’s in our dataset. This is Test 1 - 3 Bears - Forward. We’re pulling cleaned-up names and assigned groups from our final dataset that we used in our AOI analysis. Then we are removing participants whose Three Bears Forward story wasn’t included in our AOI analysis due to <25% looking time or other reasons.

library(tidyverse)
library(openxlsx)
library(janitor)

# Get Three Bears data
data <- read.xlsx("Test1_Cindy_bears_FW_Examine for Spatial Referencing.xlsx") %>%
  clean_names() %>%
  rename(y = gaze_point_y_mc_spx,
         language = language_value,
         name = participant_name,
         group = group_value)

# Pull clean names and join to data (and add Laura2 for Laura (missing stories))
cleannames <- read_csv("partnames.csv") %>%
  distinct() %>%
  rename(name = participant) %>%
  filter(name != "Laura2")

data <- data %>% 
  left_join(cleannames, by = "name") %>%
  select(-name) %>%
  rename(name = new_participant) %>%
  filter(!is.na(name))

# Pull final group assignments and join to data
cleangroups <- read_csv("finaldataset.csv") %>%
  select(participant, maingroup) %>%
  rename(name = participant) %>%
  distinct()

data <- data %>% left_join(cleangroups, by = "name") %>%
  select(-group)

# Let's find out who was NOT included in Three Bears
excluded <- read_csv("finaldataset.csv") %>%
  select(participant, maingroup, story, direction, eye_exclude) %>%
  filter(story == "Goldilocks" & direction == "forward") %>%
  rename(name = participant) %>%
  select(name, eye_exclude)

data <- data %>% left_join(excluded, by = "name") %>%
  filter(!eye_exclude) %>%
  filter(!is.na(eye_exclude))

data %>% select(name, maingroup) %>% distinct()

Now let’s graph!!

Messy, I know, but already we can see some HearingNovice has big shifts downward. And some HearingLate too.

data %>%
  ggplot(aes(x = gaze_point_index, y = y, color = maingroup, group = name)) + geom_line() + 
  scale_y_reverse(limits = c(1200,0)) +
  theme_bw()

Group Averages

Next, let’s make group averages.

averaged_y <- data %>%
  group_by(maingroup, gaze_point_index) %>%
  summarise(y_mean = mean(y, na.rm = T),
            y_sd = sd(y, na.rm = T),
            y_count = n(),
            y_se = y_sd/sqrt(y_count))

averaged_y %>%
  ggplot() + 
  geom_line(aes(x = gaze_point_index, y = y_mean, color = maingroup)) +
  geom_ribbon(aes(x = gaze_point_index, 
                  ymin = y_mean-y_se, 
                  ymax = y_mean+y_se,
                  fill = maingroup), alpha = 0.5) +
  scale_y_reverse(limits = c(1200,0)) +
  theme_bw() +
  facet_wrap("maingroup")

averaged_y %>%
  ggplot() + 
  geom_line(aes(x = gaze_point_index, y = y_mean, color = maingroup)) +
  geom_ribbon(aes(x = gaze_point_index, 
                  ymin = y_mean-y_se, 
                  ymax = y_mean+y_se,
                  fill = maingroup), alpha = 0.5) +
  scale_y_reverse(limits = c(1200,0)) +
  theme_bw()

Group Averages With Smoothing

So I’ll back up and smooth each person’s data using a moving average window of span = 5. Taken from our adult manuscript which had this:

The data were then smoothed with a standard moving average noise reduction algorithm (window size = 5 samples) which acts as a low-pass filter that reduces the influence of microsaccades, blinks, and large data gaps (based on Yarbus, 1967).

The below chart shows Adam’s data, blue is unsmoothed and red is smoothed.

data <- data %>%
  group_by(maingroup, recording_name) %>%
  mutate(y_ma = RcppRoll::roll_mean(y, n = 5, fill = 0))

data %>%
  filter(recording_name == "Adam_Good") %>%
  ggplot() +
  geom_line(aes(x = gaze_point_index, y = y), color = "blue", alpha = 0.25, size = 0.5) +
  geom_line(aes(x = gaze_point_index, y = y_ma), color = "red", size = 0.2) +
  scale_y_reverse(limits = c(475, 325)) +
  theme_bw()

So that’s nice. Let’s go do group averages again.

averaged_y <- data %>%
  group_by(maingroup, gaze_point_index) %>%
  summarise(y_mean = mean(y_ma, na.rm = T),
            y_sd = sd(y_ma, na.rm = T),
            y_count = n(),
            y_se = y_sd/sqrt(y_count))

averaged_y %>%
  ggplot() + 
  geom_line(aes(x = gaze_point_index, y = y_mean, color = maingroup)) +
  geom_ribbon(aes(x = gaze_point_index, 
                  ymin = y_mean-y_se, 
                  ymax = y_mean+y_se,
                  fill = maingroup), alpha = 0.5) +
  scale_y_reverse(limits = c(1200,0)) +
  theme_bw() +
  facet_wrap("maingroup")

averaged_y %>%
  ggplot() + 
  geom_line(aes(x = gaze_point_index, y = y_mean, color = maingroup)) +
  geom_ribbon(aes(x = gaze_point_index, 
                  ymin = y_mean-y_se, 
                  ymax = y_mean+y_se,
                  fill = maingroup), alpha = 0.5) +
  scale_y_reverse(limits = c(1200,0)) +
  theme_bw()

averaged_y %>%
  filter(maingroup == "DeafEarly" | maingroup == "HearingNovice") %>%
  ggplot() + 
  geom_line(aes(x = gaze_point_index, y = y_mean, color = maingroup)) +
  geom_ribbon(aes(x = gaze_point_index, 
                  ymin = y_mean-y_se, 
                  ymax = y_mean+y_se,
                  fill = maingroup), alpha = 0.5) +
  scale_y_reverse(limits = c(700,300)) +
  theme_bw()

Group Averages With More Smoothing

Maybe we should smooth even more. Sample size = 10!

data <- data %>%
  group_by(maingroup, recording_name) %>%
  mutate(y_ma2 = RcppRoll::roll_mean(y, n = 10, fill = 0))

# data %>%
#   filter(recording_name == "Adam_Good") %>%
#   ggplot() +
#   geom_line(aes(x = gaze_point_index, y = y), color = "blue", alpha = 0.25, size = 0.5) +
#   geom_line(aes(x = gaze_point_index, y = y_ma2), color = "red", size = 0.2) +
#   scale_y_reverse(limits = c(475, 325)) +
#   theme_bw()

averaged_y <- data %>%
  group_by(maingroup, gaze_point_index) %>%
  summarise(y_mean = mean(y_ma2, na.rm = T),
            y_sd = sd(y_ma2, na.rm = T),
            y_count = n(),
            y_se = y_sd/sqrt(y_count))

write_csv(averaged_y, "bears_time_series_group_averages.csv")

library(hrbrthemes)

Registered S3 methods overwritten by 'htmltools':
  method               from         
  print.html           tools:rstudio
  print.shiny.tag      tools:rstudio
  print.shiny.tag.list tools:rstudio

averaged_y %>%
  ggplot() + 
  geom_line(aes(x = gaze_point_index, y = y_mean, color = maingroup), size = 0.8) +
  geom_ribbon(aes(x = gaze_point_index, 
                  ymin = y_mean-y_se, 
                  ymax = y_mean+y_se,
                  fill = maingroup), alpha = 0.5) +
  scale_y_reverse(limits = c(1200,0)) +
  facet_wrap("maingroup") +
  labs(x = "time (ms)", y = "pixels", title = "Figure 1. Vertical Eye Gaze Position Across One ASL Narrative") +
  guides(color = F, fill = F) +
  theme_ipsum_rc()

averaged_y %>%
  ggplot() + 
  geom_line(aes(x = gaze_point_index, y = y_mean, color = maingroup)) +
  geom_ribbon(aes(x = gaze_point_index, 
                  ymin = y_mean-y_se, 
                  ymax = y_mean+y_se,
                  fill = maingroup), alpha = 0.5) +
  scale_y_reverse(limits = c(1200,0)) +
  theme_bw()

averaged_y %>%
  filter(maingroup == "DeafEarly" | maingroup == "HearingNovice") %>%
  ggplot() + 
  geom_line(aes(x = gaze_point_index, y = y_mean, color = maingroup), size = 0.8) +
  geom_ribbon(aes(x = gaze_point_index, 
                  ymin = y_mean-y_se, 
                  ymax = y_mean+y_se,
                  fill = maingroup), alpha = 0.1) +
  scale_y_reverse(limits = c(700,300)) +
  labs(x = "time (ms)", y = "pixels", title = "Figure 2. Deaf Early Signers vs. Hearing Novice Signers", color = "", fill = "") +
  theme_ipsum_rc()

Everything Else That Was Already Here

Next let’s plot the moments where spatial referencing happens. Those are frames

1. 198 to 223
2. 265 to 288
3. 352 to 380

The max gazepointindex is around 2580. At 120 Hz, that’s 21.5 seconds which is just right, that’s the length. Let’s go ahead and convert gazepointindex to seconds.

So we just have to convert frames to gazepointindex. The video is a total of 536 frames, at 25 FPS that’s 21.5 seconds. 535/25 = 21.5, so we divide all those frames by 25.

1. 7.92s to 8.92s
2. 10.6s to 11.52s
3. 14.08s to 15.2s

And plot those!

data <- data %>%
  rowwise() %>%
  mutate(secs = gaze_point_index/120)

data %>%
  ggplot(aes(x = secs, y = y, color = maingroup, group = name)) + 
  scale_y_reverse() + 
  geom_line() + 
  annotate("rect", xmin = 7.92, xmax = 8.92, ymin = 0, ymax = 900,
  alpha = .2, fill = "red") +
  annotate("rect", xmin = 10.6, xmax = 11.52, ymin = 0, ymax = 900,
  alpha = .2, fill = "red") +
  annotate("rect", xmin = 14.08, xmax = 15.2, ymin = 0, ymax = 900,
  alpha = .2, fill = "red") +
  theme_bw()

Maybe easier if we separate groups of signers.

data %>%
  ggplot(aes(x = secs, y = y, color = maingroup, group = name)) + 
  scale_y_reverse() + 
  geom_line(alpha = 0.5) + 
  annotate("rect", xmin = 7.92, xmax = 8.92, ymin = 0, ymax = 900,
  alpha = .2, fill = "red") +
  annotate("rect", xmin = 10.6, xmax = 11.52, ymin = 0, ymax = 900,
  alpha = .2, fill = "red") +
  annotate("rect", xmin = 14.08, xmax = 15.2, ymin = 0, ymax = 900,
  alpha = .2, fill = "red") +
  facet_grid(maingroup ~ .) +
  theme_bw() +
  guides(color = FALSE)

Next, we’re going to add AOI position information. We’re going to pull in information on signers’ right hand position (and then apply the same idea to other body parts). I successfully wrote a function called get_xy_timestamp to do this! Yay. I’m chuffed, as the British would say.

Let’s try this on Stephanie’s data. Let’s see if we can find a correlation between any of those and the eye gaze y-position.

# We add one more row to the xy_timestamp data to align it with the end of the eye gaze data.
rhand <- get_xy_timestamp("aoi_position/Cindy_bears_FW_Position of Right Hand.txt") %>%
  add_row(sec = 21.5, x = 640.16, y = 1055.97)

Error: 'aoi_position/Cindy_bears_FW_Position of Right Hand.txt' does not exist in current working directory ('/Users/adamstone/Dropbox/_UCSD/Data Analysis/Study1AdultsNew').

Now let’s work on correlations. First, our AOI vectors are not the same size as our eye gaze vectors, and the x/y position is irregularly spaced across time (irregularly spaced key frames).

# The following code will "expand" the rhand data vectors to fit the length of Stephanie's data vectors.
time_index <- steph$secs
closest <- function(x){
  which.min(abs(time_index-x))
}
index_loc <- map_int(rhand$sec, closest)
rhand <- cbind(rhand, time_index[index_loc]) %>%
  select(-sec) %>%
  rename(sec = "time_index[index_loc]") %>%
  select(sec, x, y)
rhand_full <- select(steph, secs) %>%
  rename(sec = secs) %>%
  left_join(rhand) %>%
  fill(x) %>%
  fill(y) %>%
  slice(1:(nrow(.)-1))

Joining, by = "sec"

rhand_full <- rhand_full %>%
  filter(sec < rhand$sec[172]) %>%
  filter(sec >= rhand$sec[2])
steph <- steph %>%
  filter(secs < rhand$sec[172]) %>%
  filter(secs >= rhand$sec[2])
a <- rhand_full$y
a <- a[1:length(a)-1] # Shorten it by one element
b <- steph$y
# Then run correlations
cor(a,b, use = "complete.obs") # basic correlation

[1] 0.2894728

that <- ccf(a,b, lag.max = 400, type = "correlation", na.action = na.pass, plot = T) # auto-correlation

Let’s separate out individual signers.

make_signer_plots <- function(groupname, line_color) {
  data %>%
  filter(maingroup == groupname) %>%
  ggplot(aes(x = secs, y = y)) + 
  scale_y_reverse() + 
  geom_line(alpha = 1, color = line_color) + 
  annotate("rect", xmin = 7.92, xmax = 8.92, ymin = 0, ymax = 900,
  alpha = .2, fill = "red") +
  annotate("rect", xmin = 10.6, xmax = 11.52, ymin = 0, ymax = 900,
  alpha = .2, fill = "red") +
  annotate("rect", xmin = 14.08, xmax = 15.2, ymin = 0, ymax = 900,
  alpha = .2, fill = "red") +
  geom_step(data = rhand, aes(x = sec, y = y), color = "red", linetype = "longdash", alpha = 0.5) + 
  geom_step(data = lhand, aes(x = sec, y = y), color = "blue", linetype = "longdash", alpha = 0.5) + 
  geom_step(data = mouth, aes(x = sec, y = y), color = "black", linetype = "longdash", alpha = 0.5) + 
  annotate("text", label = "Right Hand", x = 3, y = 1000, color = "red", alpha = 0.5) +
  annotate("text", label = "Left Hand", x = 3, y = 1100, color = "blue", alpha = 0.5) +
  annotate("text", label = "Mouth", x = 3, y = 200, color = "black", alpha = 0.5) +
  facet_grid(name ~ .) +
  ggtitle(groupname) +
  theme_bw()
}
make_signer_plots("DeafEarly", "red")

make_signer_plots("DeafLate", "dark green")

make_signer_plots("HearingLate", "blue")

make_signer_plots("HearingNovice", "purple")

Okay so with Early ASL obviously very steady gaze. NoviceASL has lot of downshifts. Some align with spatial referencing, some do not. We need more of them (let’s look at other stories w better data).

Midas Forward

# Get Midas data
data <- read_csv("../Adult Data/rawdata/midasfw.csv") %>%
  clean_names() %>%
  rename(y = gaze_point_y_mc_spx,
         language = language_value,
         name = participant_name,
         group = group_value)
# Pull clean names and join to data
cleannames <- read_csv("partnames.csv") %>%
  distinct() %>%
  rename(name = participant)
data <- data %>% left_join(cleannames, by = "name") %>%
  select(-name) %>%
  rename(name = new_participant) %>%
  filter(!is.na(name))
# Pull final group assignments and join to data
cleangroups <- read_csv("finaldataset.csv") %>%
  select(participant, maingroup) %>%
  rename(name = participant) %>%
  distinct()
data <- data %>% left_join(cleangroups, by = "name") %>%
  select(-group)
# Let's find out who was NOT included in Three Bears
excluded <- read_csv("finaldataset.csv") %>%
  select(participant, maingroup, story, direction, eye_exclude) %>%
  filter(story == "KingMidas" & direction == "forward") %>%
  rename(name = participant) %>%
  select(name, eye_exclude)
data <- data %>% left_join(excluded, by = "name") %>%
  filter(!eye_exclude) %>%
  filter(!is.na(eye_exclude))
data %>% select(name, maingroup) %>% distinct()

Now let’s graph!!

Hm. One person seems wrong.

data %>%
  ggplot(aes(x = gaze_point_index, y = y, color = maingroup, group = name)) + geom_line() + scale_y_reverse()

Okay it’s Jesse’s data that seems off. We’ll remove him for now and come back to it, figure out why.

data %>% filter(gaze_point_index > 30000) %>% select(name) %>% distinct() %>% head()

data <- data %>%
  filter(name != "Jesse")
data %>%
  ggplot(aes(x = gaze_point_index, y = y, color = maingroup, group = name)) + geom_line() + 
  scale_y_reverse() +
  scale_x_continuous(limits = c(0,4500))

Next let’s plot the moments where spatial referencing happens. Those are frames

1. 248 to 427
2. 460 to 508
3. 512 to 560

Like before, we’ll convert gazepointindex to seconds (by dividing 120) and all frames to seconds (by dividing 25).

1. 9.92s to 17.08s
2. 18.4s to 20.32s
3. 20.48s to 22.4s

data <- data %>%
  rowwise() %>%
  mutate(secs = gaze_point_index/120)
data %>%
  ggplot(aes(x = secs, y = y, color = maingroup, group = name)) + 
  scale_y_reverse() + 
  scale_x_continuous(limits = c(0, 37.5)) +
  geom_line() + 
  annotate("rect", xmin = 9.92, xmax = 17.08, ymin = 0, ymax = 900,
  alpha = .2, fill = "red") +
  annotate("rect", xmin = 18.4, xmax = 20.32, ymin = 0, ymax = 900,
  alpha = .2, fill = "red") +
  annotate("rect", xmin = 20.48, xmax = 22.4, ymin = 0, ymax = 900,
  alpha = .2, fill = "red")

Maybe easier if we separate groups of signers.

data %>%
  ggplot(aes(x = secs, y = y, color = maingroup, group = name)) + 
  scale_y_reverse() + 
  scale_x_continuous(limits = c(0, 37.5)) +
  geom_line(alpha = 0.5) + 
  annotate("rect", xmin = 9.92, xmax = 17.08, ymin = 0, ymax = 900,
  alpha = .2, fill = "red") +
  annotate("rect", xmin = 18.4, xmax = 20.32, ymin = 0, ymax = 900,
  alpha = .2, fill = "red") +
  annotate("rect", xmin = 20.48, xmax = 22.4, ymin = 0, ymax = 900,
  alpha = .2, fill = "red") +
  facet_grid(maingroup ~ .)

Individual signers.

data %>%
  filter(maingroup == "DeafEarly") %>%
  ggplot(aes(x = secs, y = y, group = name)) + 
  scale_x_continuous(limits = c(0, 37.5)) +
  scale_y_reverse() + 
  geom_line(alpha = 1, color = "red") + 
  annotate("rect", xmin = 9.92, xmax = 17.08, ymin = 0, ymax = 900,
  alpha = .2, fill = "red") +
  annotate("rect", xmin = 18.4, xmax = 20.32, ymin = 0, ymax = 900,
  alpha = .2, fill = "red") +
  annotate("rect", xmin = 20.48, xmax = 22.4, ymin = 0, ymax = 900,
  alpha = .2, fill = "red") +
  facet_grid(name ~ .) +
  ggtitle("DeafEarly")

data %>%
  filter(maingroup == "DeafLate") %>%
  ggplot(aes(x = secs, y = y, group = name)) + 
  scale_y_reverse() + 
  scale_x_continuous(limits = c(0, 37.5)) +
  geom_line(alpha = 1, color = "dark green") + 
  annotate("rect", xmin = 9.92, xmax = 17.08, ymin = 0, ymax = 900,
  alpha = .2, fill = "red") +
  annotate("rect", xmin = 18.4, xmax = 20.32, ymin = 0, ymax = 900,
  alpha = .2, fill = "red") +
  annotate("rect", xmin = 20.48, xmax = 22.4, ymin = 0, ymax = 900,
  alpha = .2, fill = "red") +
  facet_grid(name ~ .) +
  ggtitle("DeafLate")

data %>%
  filter(maingroup == "HearingLate") %>%
  ggplot(aes(x = secs, y = y, group = name)) + 
  scale_y_reverse() + 
  scale_x_continuous(limits = c(0, 37.5)) +
  geom_line(alpha = 1, color = "blue") + 
  annotate("rect", xmin = 9.92, xmax = 17.08, ymin = 0, ymax = 900,
  alpha = .2, fill = "red") +
  annotate("rect", xmin = 18.4, xmax = 20.32, ymin = 0, ymax = 900,
  alpha = .2, fill = "red") +
  annotate("rect", xmin = 20.48, xmax = 22.4, ymin = 0, ymax = 900,
  alpha = .2, fill = "red") +
  facet_grid(name ~ .) +
  ggtitle("HearingLate")

data %>%
  filter(maingroup == "HearingNovice") %>%
  ggplot(aes(x = secs, y = y, group = name)) + 
  scale_y_reverse() + 
  scale_x_continuous(limits = c(0, 37.5)) +
  geom_line(alpha = 1, color = "purple") + 
  annotate("rect", xmin = 9.92, xmax = 17.08, ymin = 0, ymax = 900,
  alpha = .2, fill = "red") +
  annotate("rect", xmin = 18.4, xmax = 20.32, ymin = 0, ymax = 900,
  alpha = .2, fill = "red") +
  annotate("rect", xmin = 20.48, xmax = 22.4, ymin = 0, ymax = 900,
  alpha = .2, fill = "red") +
  facet_grid(name ~ .) +
  ggtitle("HearingNovice")